home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / Oberon⁄F™ 1.2 / Preinstalled version / Obx / Mod / Cubes / Cubes (.txt)
Encoding:
Oberon Document  |  1996-04-11  |  12.1 KB  |  328 lines  |  [oODC/obnF]
  1. Documents.StdDocumentDesc
  2. Documents.DocumentDesc
  3. Containers.ViewDesc
  4. Views.ViewDesc
  5. Stores.StoreDesc
  6. Documents.ModelDesc
  7. Containers.ModelDesc
  8. Models.ModelDesc
  9. Stores.ElemDesc
  10. TextViews.StdViewDesc
  11. TextViews.ViewDesc
  12. TextModels.StdModelDesc
  13. TextModels.ModelDesc
  14. TextModels.AttributesDesc
  15. Geneva
  16. Geneva
  17. Geneva
  18. Helvetica
  19. DevCommanders.StdViewDesc
  20. DevCommanders.ViewDesc
  21. MODULE  ObxCubes;
  22. (* Adopted from a program written in C in 1986 by
  23.     Roland Karlsson, Swedish Institute for Computer Science (SICS), roland@sics.se *)
  24.     IMPORT Views, Ports, Properties, Services, Stores, Models, Math, Controllers, StdCmds, Containers, Dialog;
  25.     CONST
  26.         pi2 = 255;
  27.         minVersion = 0; maxVersion = 1;
  28.         invisible = Ports.white;
  29.     TYPE
  30.         Colors = ARRAY 6 OF Ports.Color;
  31.         View = POINTER TO RECORD (Views.ViewDesc)
  32.             fi1, fi2: INTEGER;    (* rotation angles *)
  33.             colors: Colors;    (* colors of the six sides of the cube *)
  34.         END;
  35.         Action = POINTER TO RECORD (Services.ActionDesc) END;
  36.         Msg = RECORD (Models.Message) 
  37.             consumed: BOOLEAN
  38.         END;
  39.         action: Action;
  40.         actionIsActive: BOOLEAN;
  41.         actual: View;
  42.         sinus: ARRAY 256 OF INTEGER;
  43.         para*: RECORD (Dialog.Interactor)
  44.             colors*: Colors;
  45.         END;
  46.     (* property dialog *)
  47.     PROCEDURE Singleton (): View;
  48.         VAR v: Views.View; oldp: BOOLEAN;
  49.     BEGIN
  50.         oldp := Controllers.path;
  51.         Controllers.SetCurrentPath(Controllers.targetPath);
  52.         v := Containers.FocusSingleton();
  53.         Controllers.SetCurrentPath(oldp);
  54.         IF (v # NIL) & (v IS View) THEN RETURN v(View) ELSE RETURN NIL END
  55.     END Singleton;
  56.     PROCEDURE Notify* (op, from, to: LONGINT);
  57.         VAR v: View;
  58.     BEGIN
  59.         v := Singleton();
  60.         IF v # NIL THEN v.colors := para.colors END
  61.     END Notify;
  62.     (* Action *)
  63.     PROCEDURE (a: Action) Do;
  64.         VAR msg: Msg; v: View;
  65.     BEGIN
  66.         msg.consumed := FALSE;
  67.         Views.Omnicast(msg);
  68.         IF msg.consumed THEN (* update Color Property Editor *)
  69.             v := Singleton();
  70.             IF (v # NIL) & (actual # v) THEN
  71.                 para.colors := v.colors;
  72.                 Dialog.Update(para);
  73.                 actual := v
  74.             END;
  75.             Services.DoLater(a, Services.Ticks() + Services.resolution DIV 10)
  76.                 (* i.e. perform a full rotation through all 256 states in 25.6 seconds *)
  77.         ELSE
  78.             actionIsActive := FALSE
  79.         END
  80.     END Do;
  81.     (* View *)
  82.     PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
  83.         VAR i: INTEGER;
  84.     BEGIN
  85.         v.Externalize^(wr);
  86.         wr.WriteVersion(maxVersion);
  87.         wr.WriteInt(v.fi1); wr.WriteInt(v.fi2);
  88.         FOR i := 0 TO 5 DO wr.WriteLInt(v.colors[i]) END;
  89.     END Externalize;
  90.     PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
  91.         VAR version: SHORTINT; i: INTEGER;
  92.     BEGIN
  93.         v.Internalize^(rd);
  94.         IF ~rd.cancelled THEN
  95.             rd.ReadVersion(minVersion, maxVersion, version);
  96.             IF ~rd.cancelled THEN
  97.                 rd.ReadInt(v.fi1); rd.ReadInt(v.fi2);
  98.                 IF version = maxVersion THEN
  99.                     FOR i := 0 TO 5 DO rd.ReadLInt(v.colors[i]) END
  100.                 ELSE
  101.                     FOR i := 0 TO 5 DO v.colors[i] := invisible END
  102.                 END
  103.             END
  104.         END
  105.     END Internalize;
  106.     PROCEDURE (v: View) CopyFrom (source: Views.View);
  107.     BEGIN
  108.         v.CopyFrom^(source);
  109.         WITH source: View DO
  110.             v.fi1 := source.fi1; v.fi2 := source.fi2; 
  111.             v.colors := source.colors
  112.         END
  113.     END CopyFrom;
  114.     PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
  115.     BEGIN
  116.         WITH msg: Properties.SizePref DO
  117.             IF (msg.w > Views.undefined) & (msg.h > Views.undefined) THEN
  118.                 Properties.ProportionalConstraint(1, 1, msg.fixedW, msg.fixedH, msg.w, msg.h);
  119.                 IF msg.w < 10 * Ports.mm THEN
  120.                     msg.w := 10 * Ports.mm; msg.h := msg.w
  121.                 END
  122.             ELSE
  123.                 msg.w := 40*Ports.mm; msg.h := msg.w;
  124.             END
  125.         | msg: Properties.FocusPref DO
  126.             msg.hotFocus := TRUE
  127.         ELSE
  128.         END
  129.     END HandlePropMsg;
  130.     PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
  131.                                                                 VAR focus: Views.View);
  132.         VAR c: Containers.Controller;
  133.     BEGIN
  134.         WITH msg: Controllers.TrackMsg DO
  135.             IF Controllers.modify IN msg.modifiers THEN
  136.                 c := Containers.Focus();
  137.                 IF c.opts # Containers.mask THEN
  138.                     para.colors := v.colors;
  139.                     StdCmds.OpenToolDialog('Obx/Rsrc/Cubes', 'Cube Colors');
  140.                     c.SetSingleton(v)
  141.                 END
  142.             END
  143.         ELSE
  144.         END
  145.     END HandleCtrlMsg;
  146.     PROCEDURE (v: View) HandleModelMsg (VAR msg: Models.Message);
  147.     BEGIN
  148.         WITH msg: Msg DO
  149.             v.fi1 := (v.fi1 + 7) MOD pi2;
  150.             v.fi2 := (v.fi2 + 1) MOD pi2;
  151.             msg.consumed := TRUE;
  152.             Views.Update(v, Views.keepFrames)
  153.         ELSE
  154.         END
  155.     END HandleModelMsg;
  156.     PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: LONGINT);
  157.         VAR
  158.             fi1, fi2, a, c: INTEGER;
  159.             p0h, p0v, p1h, p1v, p2h, p2v, p3h, p3v: INTEGER;
  160.             w, h: LONGINT;
  161.             e01,e12,e23,e30,
  162.             e45, e56, e67, e74,
  163.             e04, e15, e26, e37: BOOLEAN;
  164.             p: ARRAY 4 OF Ports.Point;
  165.         PROCEDURE DrawSides(visible: BOOLEAN);
  166.         BEGIN
  167.             IF (e01 & e12 & e23 & e30 = visible) & (v.colors[0] # invisible) THEN
  168.                 p[0].x := (p0h - c) * w; p[0].y := p0v * w;
  169.                 p[1].x := (p1h - c) * w; p[1].y := p1v * w;
  170.                 p[2].x := (p2h - c) * w; p[2].y := p2v * w;
  171.                 p[3].x := (p3h - c) * w; p[3].y := p3v * w;
  172.                 f.DrawPath(p, 4, Ports.fill, v.colors[0], Ports.closedPoly)
  173.             END;
  174.             IF (e45 & e56 & e67 & e74 = visible) & (v.colors[1] # invisible)  THEN
  175.                 p[0].x := (p0h + c) * w; p[0].y := p0v * w;
  176.                 p[1].x := (p1h + c) * w; p[1].y := p1v * w;
  177.                 p[2].x := (p2h + c) * w; p[2].y := p2v * w;
  178.                 p[3].x := (p3h + c) * w; p[3].y := p3v * w;
  179.                 f.DrawPath(p, 4, Ports.fill, v.colors[1], Ports.closedPoly)
  180.             END;
  181.             IF (e01 & e15 & e45 & e04 = visible) & (v.colors[2] # invisible)  THEN
  182.                 p[0].x := (p0h - c) * w; p[0].y := p0v * w;
  183.                 p[1].x := (p1h - c) * w; p[1].y := p1v * w;
  184.                 p[2].x := (p1h + c) * w; p[2].y := p1v * w;
  185.                 p[3].x := (p0h + c) * w; p[3].y := p0v * w;
  186.                 f.DrawPath(p, 4, Ports.fill, v.colors[2], Ports.closedPoly)
  187.             END;
  188.             IF (e12 & e26 & e56 & e15 = visible) & (v.colors[3] # invisible)  THEN
  189.                 p[0].x := (p1h - c) * w; p[0].y := p1v * w;
  190.                 p[1].x := (p2h - c) * w; p[1].y := p2v * w;
  191.                 p[2].x := (p2h + c) * w; p[2].y := p2v * w;
  192.                 p[3].x := (p1h + c) * w; p[3].y := p1v * w;
  193.                 f.DrawPath(p, 4, Ports.fill, v.colors[3], Ports.closedPoly)
  194.             END;
  195.             IF (e23 & e37 & e67 & e26 = visible) & (v.colors[4] # invisible)  THEN
  196.                 p[0].x := (p2h - c) * w; p[0].y := p2v * w;
  197.                 p[1].x := (p3h - c) * w; p[1].y := p3v * w;
  198.                 p[2].x := (p3h + c) * w; p[2].y := p3v * w;
  199.                 p[3].x := (p2h + c) * w; p[3].y := p2v * w;
  200.                 f.DrawPath(p, 4, Ports.fill, v.colors[4], Ports.closedPoly)
  201.             END;
  202.             IF (e30 & e04 & e74 & e37 = visible) & (v.colors[5] # invisible)  THEN
  203.                 p[0].x := (p3h - c) * w; p[0].y := p3v * w;
  204.                 p[1].x := (p0h - c) * w; p[1].y := p0v * w;
  205.                 p[2].x := (p0h + c) * w; p[2].y := p0v * w;
  206.                 p[3].x := (p3h + c) * w; p[3].y := p3v * w;
  207.                 f.DrawPath(p, 4, Ports.fill, v.colors[5], Ports.closedPoly)
  208.             END;
  209.             IF e01 = visible THEN
  210.                 f.DrawLine((p0h - c) * w, p0v * w, (p1h - c) * w, p1v * w, 0, Ports.black)
  211.             END;
  212.             IF e12 = visible THEN
  213.                 f.DrawLine((p1h - c) * w, p1v * w, (p2h - c) * w, p2v * w, 0, Ports.black)
  214.             END;
  215.             IF e23 = visible THEN
  216.                 f.DrawLine((p2h - c) * w, p2v * w, (p3h - c) * w, p3v * w, 0, Ports.black)
  217.             END;
  218.             IF e30 = visible THEN
  219.                 f.DrawLine((p3h - c) * w, p3v * w, (p0h - c) * w, p0v * w, 0, Ports.black)
  220.             END;
  221.             IF e45 = visible THEN
  222.                 f.DrawLine((p0h + c) * w, p0v * w, (p1h + c) * w, p1v * w, 0, Ports.black)
  223.             END;
  224.             IF e56 = visible THEN
  225.                 f.DrawLine((p1h + c) * w, p1v * w, (p2h + c) * w, p2v * w, 0, Ports.black)
  226.             END;
  227.             IF e67 = visible THEN
  228.                 f.DrawLine((p2h + c) * w, p2v * w, (p3h + c) * w, p3v * w, 0, Ports.black)
  229.             END;
  230.             IF e74 = visible THEN
  231.                 f.DrawLine((p3h + c) * w, p3v * w, (p0h + c) * w, p0v * w, 0, Ports.black)
  232.             END;
  233.             IF e04 = visible THEN
  234.                 f.DrawLine((p0h + c) * w, p0v * w, (p0h - c) * w, p0v * w, 0, Ports.black)
  235.             END;
  236.             IF e15 = visible THEN
  237.                 f.DrawLine((p1h + c) * w, p1v * w, (p1h - c) * w, p1v * w, 0, Ports.black)
  238.             END;
  239.             IF e26 = visible THEN
  240.                 f.DrawLine((p2h + c) * w, p2v * w, (p2h - c) * w, p2v * w, 0, Ports.black)
  241.             END;
  242.             IF e37 = visible THEN
  243.                 f.DrawLine((p3h + c) * w, p3v * w, (p3h - c) * w, p3v * w, 0, Ports.black)
  244.             END;
  245.         END DrawSides;
  246.     BEGIN
  247.         IF ~actionIsActive THEN
  248.              actionIsActive := TRUE; action.Do
  249.         END;
  250.         v.context.GetSize(w, h); w := (w  DIV 170);
  251.         fi1 := v.fi1;
  252.         fi2 := v.fi2;
  253.         a := sinus[fi2];
  254.         c := (sinus[(64 - fi2) MOD pi2] * 91) DIV 128; (* 91/128 := sqrt(2)  *)
  255.         p0v := 85 + sinus[fi1];
  256.         p0h := 85 + (a * sinus[(64 - fi1) MOD pi2]) DIV 64;
  257.         p1v := 85 + sinus[(64 + fi1) MOD pi2];
  258.         p1h := 85 + (a * sinus[(-fi1) MOD pi2]) DIV 64;
  259.         p2v := 85 + sinus[(128 + fi1) MOD pi2];
  260.         p2h := 85 + (a * sinus[(-64 - fi1) MOD pi2]) DIV 64;
  261.         p3v := 85 + sinus[(192 + fi1) MOD pi2];
  262.         p3h := 85 + (a * sinus[(-128 - fi1) MOD pi2]) DIV 64;
  263.         (* determine visibility of the twelve edges *)
  264.         e01 :=  ~((((fi2 - 192) MOD pi2 < 64) & ((fi1 - 32) MOD pi2 < 128))
  265.                 OR (((fi2 - 128) MOD pi2 < 64) & ((fi1 - 160) MOD pi2 < 128)));
  266.         e12 := ~((((fi2 - 192) MOD pi2 < 64) & ((fi1 - 224) MOD pi2 < 128))
  267.                 OR (((fi2 - 128) MOD pi2 < 64) & ((fi1 - 96) MOD pi2 < 128)));
  268.         e23 := ~((((fi2 - 192) MOD pi2 < 64) & ((fi1 - 160) MOD pi2 < 128))
  269.                 OR (((fi2 - 128) MOD pi2 < 64) & ((fi1 - 32) MOD pi2 < 128)));
  270.         e30 := ~((((fi2 - 192) MOD pi2 < 64) & ((fi1 - 96) MOD pi2 < 128))
  271.                 OR (((fi2 - 128) MOD pi2 < 64) & ((fi1 - 224) MOD pi2 < 128)));
  272.         e45 := ~((((fi2) MOD pi2 < 64) & ((fi1 - 32) MOD pi2 < 128))
  273.                 OR (((fi2 - 64) MOD pi2 < 64) & ((fi1 - 160) MOD pi2 < 128)));
  274.         e56 := ~((((fi2) MOD pi2 < 64) & ((fi1 - 224) MOD pi2 < 128))
  275.                 OR (((fi2 - 64) MOD pi2 < 64) & ((fi1 - 96) MOD pi2 < 128)));
  276.         e67 := ~((((fi2) MOD pi2 < 64) & ((fi1 - 160) MOD pi2 < 128))
  277.                 OR (((fi2 - 64) MOD pi2 < 64) & ((fi1 - 32) MOD pi2 < 128)));
  278.         e74 := ~((((fi2) MOD pi2 < 64) & ((fi1 - 96) MOD pi2 < 128))
  279.                 OR (((fi2 - 64) MOD pi2 < 64) & ((fi1 - 224) MOD pi2 < 128)));
  280.         e04 := ~((((fi2 - 64) MOD pi2 < 128) & ((fi1 - 224) MOD pi2 < 64))
  281.                 OR (((fi2 - 192) MOD pi2 < 128) & ((fi1 - 96) MOD pi2 < 64)));
  282.         e15 := ~((((fi2 - 64) MOD pi2 < 128) & ((fi1 - 160) MOD pi2 < 64))
  283.                 OR (((fi2 - 192) MOD pi2 < 128) & ((fi1 - 32) MOD pi2 < 64)));
  284.         e26 := ~((((fi2 - 64) MOD pi2 < 128) & ((fi1 - 96) MOD pi2 < 64))
  285.                 OR (((fi2 - 192) MOD pi2 < 128) & ((fi1 - 224) MOD pi2 < 64)));
  286.         e37 := ~((((fi2 - 64) MOD pi2 < 128) & ((fi1 - 32) MOD pi2 < 64))
  287.                 OR (((fi2 - 192) MOD pi2 < 128) & ((fi1 - 160) MOD pi2 < 64)));
  288.         DrawSides(FALSE);    (* draw hidden sides and edges *)
  289.         DrawSides(TRUE);    (* draw visible sides and edges *)
  290.     END Restore;
  291.     (* commands *)
  292.     PROCEDURE Deposit*;
  293.         VAR v: View;
  294.     BEGIN
  295.         NEW(v);
  296.         v.fi1 := 0; v.fi2 := 0;
  297.         v.colors := para.colors;
  298.         Views.Deposit(v)
  299.     END Deposit;
  300.     PROCEDURE InitData;
  301.         VAR i: INTEGER;
  302.     BEGIN (* Pi = 128 *)
  303.         FOR i := 0 TO 255 DO
  304.             sinus[i] := SHORT(Math.Floor(0.5 + 64 *  Math.Sin(i * 2*Math.Pi() / 256)))
  305.         END;
  306.         para.colors[0] := Ports.green;
  307.         para.colors[1] := Ports.blue;
  308.         para.colors[2] := invisible;
  309.         para.colors[3] := Ports.red;
  310.         para.colors[4] := invisible;
  311.         para.colors[5] := Ports.red + Ports.green    (* yellow *)
  312.     END InitData;
  313. BEGIN InitData; NEW(action); actionIsActive := FALSE;
  314. END ObxCubes.
  315.  "ObxCubes.Deposit; StdCmds.PasteView"
  316.  "StdCmds.OpenToolDialog('Obx/Rsrc/Cubes', 'Cube Colors')"
  317. TextControllers.StdCtrlDesc
  318. TextControllers.ControllerDesc
  319. Containers.ControllerDesc
  320. Controllers.ControllerDesc
  321. TextRulers.StdRulerDesc
  322. TextRulers.RulerDesc
  323. TextRulers.StdStyleDesc
  324. TextRulers.StyleDesc
  325. TextRulers.AttributesDesc
  326. Helvetica
  327. Documents.ControllerDesc
  328.